home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_arith.m < prev    next >
Text File  |  1992-07-15  |  19KB  |  808 lines
  1. /*
  2.  *    MP_Lisp
  3.  *
  4.  *    Author:        S.C.Merrall
  5.  *
  6.  *    File:        mp_arith.m
  7.  *
  8.  *    Contents:    int_bin_op
  9.  *            float_bin_op
  10.  *            bin_op
  11.  *            make_integer (Don't think we need this any more)
  12.  *            reduce
  13.  *            scan
  14.  *
  15.  *    Description:       Functions to create and manipulate numeric objects
  16.  *            to date, only integers.
  17.  *            
  18.  *
  19.  *    Change History:
  20.  *
  21.  *    Date   Name Comment
  22.  *    -------- ---- -------
  23.  *    26:02:91 SCM  Created
  24.  *    22:04:91 SCM  Now use MasPar Plural Heap objects
  25.  *    15:05:91 SCM  mp_int_add => plus, added make_integer
  26.  *    05:12:91 SCM  added reduce and scan
  27.  *
  28.  */
  29.  
  30. #include <mpl.h>
  31. #include <stdio.h>
  32.  
  33. #include "p_random.h"
  34.  
  35. #include "constant.h"
  36.  
  37. #include "mp_object.h"
  38. #include "mp_debug_off.h"
  39. #include "mp_type.h"
  40. #include "mp_mem_mgmt.h"
  41. #include "mp_arith.h"
  42. #include "mp_gc.h"
  43.  
  44.  
  45. /*----------------------------------------------------------------------------*
  46.  * Function   : int_bin_op
  47.  *
  48.  * Parameters : MP_PluralHeap MPPH_arg1:
  49.  *        MP_PluralHeap MPPH_arg2:
  50.  *        plural int bin_op_id:
  51.  *        MP_PluralHeap MPPH_result:
  52.  *
  53.  * Description:    Applies the given binary integer operation to the given
  54.  *        arguments and returns the result in MPPPH_result;
  55.  *
  56.  * Result     : int FAIL/SUCCESS
  57.  *---------------------------------------------------------------------------*/
  58.  
  59. #ifdef __STDC__
  60.  
  61. int int_bin_op( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  62.             plural int bin_op_id, MP_PluralHeap MPPH_result )
  63. #else
  64.  
  65. int int_bin_op( MPPH_arg1, MPPH_arg2, bin_op_id, MPPH_result )
  66.  
  67. MP_PluralHeap MPPH_arg1;
  68. MP_PluralHeap MPPH_arg2;
  69. plural int bin_op_id;
  70. MP_PluralHeap MPPH_result;
  71.  
  72. #endif
  73.  
  74. {
  75.   int result_status = SUCCESS;
  76.   plural int *plural integer1;
  77.   plural int *plural integer2;
  78.   plural int *plural result;
  79. DBG_CALL("i_bin_op");
  80. DBG_ARGS(fprintf(dbg,"MPPH_arg1=%04x, MPPH_arg2=%04x, result=%04x",MPPH_arg1,MPPH_arg2,MPPH_result));
  81.  
  82.   /* Check the two plurals are non nil - new nil and t method should mean
  83.    * we don't need this
  84.    *
  85.    * if (globalor((OA_offsets(MPPH_arg1) == NIL) ||
  86.    *           (OA_offsets(MPPH_arg2) == NIL))) {
  87.    *
  88.    *
  89.    *DBG_FAIL(fprintf(dbg,"FAIL: there are nil elements"));
  90.    *      return FAIL;
  91.    *  }
  92.    */
  93.  
  94.   if (globalor(OA_info(MPPH_arg1) != OA_info(MPPH_arg2))) {
  95.  
  96. DBG_FAIL(fprintf(dbg,"FAIL: Incompatible types"));
  97.   return FAIL;
  98.   }
  99.  
  100.   if (globalor(OA_info(MPPH_arg1) != INTEGER)) {
  101.  
  102. DBG_FAIL(fprintf(dbg,"FAIL: Not all of these are inetegers"));
  103.     return FAIL;
  104.   }
  105.   
  106.   /* Allocate space for answer */
  107.   if ( mp_alloc((plural int)INTEGER, (plural int) 1, MPPH_result) == FAIL) {
  108.  
  109. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
  110.   return FAIL;
  111.   }
  112.  
  113.   integer1 = (plural int *plural) OA_data(MPPH_arg1);
  114.   integer2 = (plural int *plural) OA_data(MPPH_arg2);
  115.   result   = (plural int *plural) OA_data(MPPH_result);
  116.  
  117.   switch (bin_op_id) {
  118.  
  119.   case MP_PLUS :     *result = *integer1 + *integer2; break;
  120.  
  121.   case MP_DIFFERENCE :     *result = *integer1 - *integer2; break;
  122.  
  123.   case MP_DIVIDE :     *result = *integer1 / *integer2; break;
  124.  
  125.   case MP_TIMES :     *result = *integer1 * *integer2; break;
  126.  
  127.   case MP_REMAINDER :     *result = *integer1 % *integer2; break;
  128.  
  129.   default  : result_status = FAIL;
  130.  
  131.   }
  132.  
  133.   if (result_status == FAIL) {
  134.  
  135. DBG_FAIL(fprintf(dbg,"FAIL: Unknown operation"));
  136.   return FAIL;
  137.   }
  138.  
  139. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  140.   return SUCCESS;
  141. }
  142.  
  143. /*----------------------------------------------------------------------------*
  144.  * Function   : real_bin_op
  145.  *
  146.  * Parameters : MP_PluralHeap MPPH_arg1:
  147.  *        MP_PluralHeap MPPH_arg2:
  148.  *        plural int bin_op_id:
  149.  *        MP_PluralHeap MPPH_result:
  150.  *
  151.  * Description:    Applies the given binary float operation to the given
  152.  *        arguments and returns the result in MPPH_result;
  153.  *
  154.  * Result     : int FAIL/SUCCESS
  155.  *---------------------------------------------------------------------------*/
  156.  
  157. #ifdef __STDC__
  158.  
  159. int real_bin_op( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  160.          plural int bin_op_id, MP_PluralHeap MPPH_result )
  161. #else
  162.  
  163. int real_bin_op( MPPH_arg1, MPPH_arg2, bin_op_id, MPPH_result )
  164.  
  165. MP_PluralHeap MPPH_arg1;
  166. MP_PluralHeap MPPH_arg2;
  167. plural int bin_op_id;
  168. MP_PluralHeap MPPH_result;
  169.  
  170. #endif
  171.  
  172. {
  173.   int result_status = SUCCESS;
  174.   plural float *plural real1;
  175.   plural float *plural real2;
  176.   plural float *plural result;
  177. DBG_CALL("float_bin_op");
  178. DBG_ARGS(fprintf(dbg,"MPPH_arg1=%04x, MPPH_arg2=%04x, result=%04x",MPPH_arg1,MPPH_arg2,MPPH_result));
  179.  
  180.   /* Check the two plurals are non nil - new system => don't need this
  181.    *
  182.    *  if (globalor((OA_offsets(MPPH_arg1) == NIL) ||
  183.    *           (OA_offsets(MPPH_arg2) == NIL))) {
  184.    *
  185.    *
  186.    *DBG_FAIL(fprintf(dbg,"FAIL: there are nil elements"));
  187.    *      return FAIL;
  188.    *  }
  189.    */
  190.  
  191.   if (globalor(OA_info(MPPH_arg1) != OA_info(MPPH_arg2))) {
  192.  
  193. DBG_FAIL(fprintf(dbg,"FAIL: Incompatible types"));
  194.   return FAIL;
  195.   }
  196.  
  197.   if (globalor(OA_info(MPPH_arg1) != MP_FLOAT)) {
  198.  
  199. DBG_FAIL(fprintf(dbg,"FAIL: Not all of these are floats"));
  200.     return FAIL;
  201.   }
  202.   
  203.   /* Allocate space for answer */
  204.   if ( mp_alloc((plural int)MP_FLOAT, (plural int) 1, MPPH_result) == FAIL) {
  205.  
  206. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
  207.   return FAIL;
  208.   }
  209.  
  210.   real1 = (plural float *plural) OA_data(MPPH_arg1);
  211.   real2 = (plural float *plural) OA_data(MPPH_arg2);
  212.   result   = (plural float *plural) OA_data(MPPH_result);
  213.  
  214.   switch (bin_op_id) {
  215.  
  216.   case MP_PLUS :     *result = *real1 + *real2; break;
  217.  
  218.   case MP_DIFFERENCE :     *result = *real1 - *real2; break;
  219.  
  220.   case MP_DIVIDE :     *result = *real1 / *real2; break;
  221.  
  222.   case MP_TIMES :     *result = *real1 * *real2; break;
  223.  
  224.   case MP_REMAINDER :     *result = fp_fmod(*real1,*real2); break;
  225.  
  226.   default  : result_status = FAIL;
  227.  
  228.   }
  229.  
  230.   if (result_status == FAIL) {
  231.  
  232. DBG_FAIL(fprintf(dbg,"FAIL: Unknown operation"));
  233.     return FAIL;
  234.   }
  235.  
  236. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  237.   return SUCCESS;
  238. }
  239.  
  240. /*----------------------------------------------------------------------------*
  241.  * Function   : cast
  242.  *
  243.  * Parameters : MP_PluralHeap MPPH_number:    MasPar Plural Heap handle on 
  244.  *                        heap space of objects to be 
  245.  *                        cast (numbers).
  246.  *        plural int type:        Types things are to be cast
  247.  *                        to INTEGER or MP_FLOAT
  248.  *              MP_PluralHeap MPPH_result:      Where the result went
  249.  *
  250.  * Description:    Creates new numbers whose values are the same as the
  251.  *        arguments but have been cast appropriately.
  252.  *
  253.  * Result     : int: FAIL/SUCCESS
  254.  *---------------------------------------------------------------------------*/
  255.  
  256. #ifdef __STDC__
  257.  
  258. int cast( MP_PluralHeap MPPH_number,plural int type,MP_PluralHeap MPPH_result)
  259.  
  260. #else
  261.  
  262. int cast( MPPH_number, type, MPPH_result )
  263.  
  264. MP_PluralHeap MPPH_number;
  265. plural int type;
  266. MP_PluralHeap MPPH_result;
  267.  
  268. #endif
  269.  
  270. {
  271.   plural int   integer, cast_integer;
  272.   plural float real,    cast_float;
  273.   plural int   initial_type;
  274. DBG_CALL("cast");
  275. DBG_ARGS(fprintf(dbg,"MPPH_number=????, type=????"));
  276.  
  277.   integer = *(plural int *plural) OA_data(MPPH_number);
  278.   real  = *(plural float *plural) OA_data(MPPH_number);
  279.  
  280.   /* Check these are all numbers of one form or another */
  281.  
  282.   initial_type = OA_info(MPPH_number);
  283.  
  284.   if (globalor((initial_type != INTEGER) &&
  285.            (initial_type != MP_FLOAT))) {
  286.  
  287. DBG_FAIL(fprintf(dbg,"FAIL: Not all of these are numbers"));
  288.     return FAIL;
  289.   }
  290.  
  291.  
  292.   /* Only work on those who are changing type */
  293.  
  294.   if (initial_type != type) {
  295.  
  296.     /* Allocate space for new values */
  297.  
  298.     if (mp_alloc(type, (plural int) 1, MPPH_result) == FAIL) {
  299.  
  300. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for new numbers"));
  301.       return FAIL;
  302.     }
  303.  
  304.     else {
  305.  
  306.       switch(initial_type) {
  307.  
  308.       case INTEGER :
  309.  
  310.     *(plural float *plural) OA_data(MPPH_result) = (plural float) integer;
  311.     break;
  312.  
  313.       case MP_FLOAT :
  314.     *(plural int *plural) OA_data(MPPH_result) = (plural int) real;
  315.     break;
  316.       }
  317.     }
  318.   }
  319.   else {
  320.  
  321.     OA_offsets(MPPH_result) = OA_offsets(MPPH_number);
  322.  
  323.   }
  324.  
  325. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  326.   return SUCCESS;
  327. }
  328.  
  329. /*----------------------------------------------------------------------------*
  330.  * Function   : bin_op
  331.  *
  332.  * Parameters : MP_PluralHeap MPPH_arg1:
  333.  *        MP_PluralHeap MPPH_arg2:
  334.  *        plural int bin_op_id:
  335.  *        MP_PluralHeap MPPH_result:
  336.  *
  337.  * Description:    Applies the given binary float operation to the given
  338.  *        arguments and returns the result in MPPH_result;
  339.  *
  340.  * Result     : int FAIL/SUCCESS
  341.  *---------------------------------------------------------------------------*/
  342.  
  343. #ifdef __STDC__
  344.  
  345. int bin_op( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  346.           plural int bin_op_id, MP_PluralHeap MPPH_result )
  347. #else
  348.  
  349. int bin_op( MPPH_arg1, MPPH_arg2, bin_op_id, MPPH_result )
  350.  
  351. MP_PluralHeap MPPH_arg1;
  352. MP_PluralHeap MPPH_arg2;
  353. plural int bin_op_id;
  354. MP_PluralHeap MPPH_result;
  355.  
  356. #endif
  357.  
  358. {
  359.   int result_status = SUCCESS;
  360.   plural natural cast_arg1 = NIL;
  361.   MP_PluralHeap MPPH_cast_arg1 = &cast_arg1;
  362.   plural natural cast_arg2 = NIL;
  363.   MP_PluralHeap MPPH_cast_arg2 = &cast_arg2;
  364.   plural int result_type;
  365. DBG_CALL("bin_op");
  366. DBG_ARGS(fprintf(dbg,"MPPH_arg1=%04x, MPPH_arg2=%04x, result=%04x",MPPH_arg1,MPPH_arg2,MPPH_result));
  367.   GC_Protect(cast_arg1);
  368.   GC_Protect(cast_arg2);
  369.  
  370.   if ((OA_info(MPPH_arg1) == MP_FLOAT) || (OA_info(MPPH_arg2) == MP_FLOAT))
  371.     result_type = MP_FLOAT;
  372.   else result_type = INTEGER;
  373.  
  374.   if ((cast(MPPH_arg1, result_type, MPPH_cast_arg1) == FAIL) ||
  375.       (cast(MPPH_arg2, result_type, MPPH_cast_arg2) == FAIL)) {
  376.  
  377. DBG_FAIL(fprintf(dbg,"FAIL: Unable to cast some of operands"));
  378.     return FAIL;
  379.   }
  380.  
  381.   if (result_type == INTEGER) {
  382.  
  383.     if (int_bin_op(MPPH_cast_arg1, MPPH_cast_arg2, bin_op_id, 
  384.            MPPH_result) == FAIL) {
  385.  
  386.       result_status = FAIL;
  387.     }
  388.   }
  389.   else {
  390.  
  391.     if (real_bin_op(MPPH_cast_arg1, MPPH_cast_arg2, bin_op_id, 
  392.            MPPH_result) == FAIL) {
  393.  
  394.       result_status = FAIL;
  395.     }
  396.   }
  397.  
  398.   if (result_status = FAIL) {
  399.  
  400. DBG_FAIL(fprintf(dbg,"FAIL: Unable to preform operation"));
  401.     return FAIL;
  402.   }
  403.  
  404.   GC_UnProtect(2);
  405. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  406.   return SUCCESS;
  407. }
  408.  
  409. #define BOTH 0
  410.  
  411. int un_op_domains[3] = {BOTH, BOTH, MP_FLOAT};
  412.  
  413. /*----------------------------------------------------------------------------*
  414.  * Function   : un_op
  415.  *
  416.  * Parameters : MP_PluralHeap MPPH_arg:
  417.  *        plural int un_op_id:
  418.  *        MP_PluralHeap MPPH_result:
  419.  *        
  420.  * Description: Preforms the appropriate unary operator on the given values.
  421.  *        Since most unary operators are floating point I have not
  422.  *        bothered to split the code into sub functions.
  423.  *
  424.  * Result     : int:    FAIL/SUCCESS
  425.  *---------------------------------------------------------------------------*/
  426.  
  427. #ifdef __STDC__
  428.  
  429. int un_op( MP_PluralHeap MPPH_arg, plural int un_op_id, 
  430.        MP_PluralHeap MPPH_result )
  431.  
  432. #else
  433.  
  434. int un_op( MPPH_arg, un_op_id, MPPH_result )
  435.  
  436. MP_PluralHeap MPPH_arg;
  437. plural int un_op_id;
  438. MP_PluralHeap MPPH_result;
  439.  
  440. #endif
  441.  
  442. {
  443.   int aok = TRUE;
  444.   plural int result_type;
  445.   plural int integer;
  446.   plural float real;
  447.   plural natural tmp = NIL;
  448.   MP_PluralHeap MPPH_tmp = &tmp;
  449.  
  450. DBG_CALL("un_op_id");
  451. DBG_ARGS(fprintf(dbg,"MPPH_arg=????,un_op_id=????,MPPH_result=????"));
  452.   GC_Protect(tmp);
  453.  
  454.   /* Check the plural is non nil - New system => type check sufficient
  455.    *
  456.    *  if (globalor(OA_offsets(MPPH_arg) == NIL)) {
  457.    *
  458.    *DBG_FAIL(fprintf(dbg,"FAIL: there are nil elements"));
  459.    *      return FAIL;
  460.    *  }
  461.    */
  462.  
  463.   /* Check the plural is all numbers of some kind */
  464.  
  465.   if (globalor((OA_info(MPPH_arg) != INTEGER) && 
  466.            (OA_info(MPPH_arg) != MP_FLOAT))) {
  467.  
  468. DBG_FAIL(fprintf(dbg,"FAIL: These aren't all numbers"));
  469.     return FAIL;
  470.   }
  471.  
  472.   if (OA_info(MPPH_arg) == INTEGER) {
  473.  
  474.     integer = *(plural int *plural) OA_data(MPPH_arg);
  475.     real    = (plural float) integer;
  476.   }
  477.  
  478.   else {
  479.  
  480.     real    = *(plural float *plural) OA_data(MPPH_arg);
  481.     integer = (plural int) real;
  482.   }
  483.  
  484.   switch (un_op_id) {
  485.  
  486.   case MP_NEGATE : real = -real; integer = -integer; break;
  487.  
  488.   case MP_ABS    : if (real < 0) { 
  489.  
  490.                      real = -real; 
  491.              integer = -integer; 
  492.            }
  493.                    break;
  494.  
  495.     /* Hack functions for cb's neural networks */
  496.  
  497.   case MP_DELTA  : if (real < 0) real = -real;
  498.                    real = 1 - real;
  499.                    break;
  500.  
  501.   case MP_SIGMA  : if (real < -1.0) real = -1.0;
  502.                    if (real > 1.0) real = 1.0;
  503.                    break;
  504.  
  505.     /* Endo of hack cb hack functions */
  506.  
  507.     default : aok = FALSE;
  508.   }
  509.  
  510.   if (!aok) {
  511.  
  512. DBG_FAIL(fprintf(dbg,"FAIL: Unknown unary operator id"));
  513.     return FAIL;
  514.   }
  515.  
  516.   /* Determine the types of the result */
  517.  
  518.   if ((OA_info(MPPH_arg) == INTEGER) && 
  519.       (un_op_domains[un_op_id-MP_UN_OP_IDS] == BOTH)) result_type = INTEGER;
  520.  
  521.   else result_type = MP_FLOAT;
  522.  
  523.   if (mp_alloc(result_type, (plural int) 1, MPPH_result) == FAIL) {
  524.  
  525. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for the result"));
  526.     return FAIL;
  527.   }
  528.  
  529.   if (result_type == INTEGER) 
  530.  
  531.     *(plural int *plural) OA_data(MPPH_result) = integer;
  532.  
  533.   else
  534.  
  535.     *(plural float *plural) OA_data(MPPH_result) = real;
  536.  
  537.   GC_UnProtect(1);
  538. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  539.   return SUCCESS;
  540.   }
  541.  
  542. /*----------------------------------------------------------------------------*
  543.  * Function   : rel_op
  544.  *
  545.  * Parameters : MP_PluralHeap MPPH_arg1:    MasPar Plural Heap handles
  546.  *        MP_PluralHeap MPPH_arg2:    on the arguments.
  547.  *        plural int op_id:        The desired operations
  548.  *        MP_PluralHeap MPPH_result:    handle on result
  549.  *
  550.  * Description: Preforms the appropriate relational operator on the two
  551.  *        argumnets. Which should be numbers. The numbers are all 
  552.  *        cast to floats and the operation preformed on these.
  553.  *        The result is a nil not nil type of thing.
  554.  *
  555.  * Result     : int:    FAIL/SUCCESS
  556.  *---------------------------------------------------------------------------*/
  557.  
  558. #ifdef __STDC__
  559.  
  560. int rel_op( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2,
  561.         plural int op_id,        MP_PluralHeap MPPH_result )
  562.  
  563. #else
  564.  
  565. int rel_op( MPPH_arg1, MPPH_arg2, op_id, MPPH_result )
  566.  
  567. MP_PluralHeap MPPH_arg1;
  568. MP_PluralHeap MPPH_arg2;
  569. plural int op_id;
  570. MP_PluralHeap MPPH_result;
  571.  
  572. #endif
  573.  
  574. {
  575.   int aok = SUCCESS;
  576.   plural float real1, real2;
  577.   plural int result;
  578.  
  579. DBG_CALL("rel_op");
  580. DBG_ARGS(fprintf(dbg,"MPPH_arg1=????,MPPH_arg2=????,op_id=????,MPPH_result=????"));
  581.  
  582.   /* Check the two plurals are non nil - New system, type check sufficient 
  583.    *
  584.    *  if (globalor((OA_offsets(MPPH_arg1) == NIL) ||
  585.    *           (OA_offsets(MPPH_arg2) == NIL))) {
  586.    *
  587.    *DBG_FAIL(fprintf(dbg,"FAIL: there are nil elements"));
  588.    *      return FAIL;
  589.    *  }
  590.    */
  591.  
  592.   /* Check these are all numbers */
  593.  
  594.   if (globalor((OA_info(MPPH_arg1) != INTEGER) && 
  595.            (OA_info(MPPH_arg1) != MP_FLOAT) &&
  596.            (OA_info(MPPH_arg2) != INTEGER) &&
  597.            (OA_info(MPPH_arg2) != MP_FLOAT))) {
  598.  
  599. DBG_FAIL(fprintf(dbg,"FAIL: Some of these aren't numbers"));
  600.     return FAIL;
  601.   }
  602.  
  603.   if (OA_info(MPPH_arg1) == MP_FLOAT) 
  604.     real1 = *(plural float *plural) OA_data(MPPH_arg1);
  605.  
  606.   else
  607.     real1 = (plural float) (*(plural int *plural) OA_data(MPPH_arg1));
  608.  
  609.   if (OA_info(MPPH_arg2) == MP_FLOAT)
  610.     real2 = *(plural float *plural) OA_data(MPPH_arg2);
  611.  
  612.   else
  613.     real2 = (plural float) (*(plural int *plural) OA_data(MPPH_arg2));
  614.  
  615.   switch (op_id) {
  616.  
  617.   case MP_LT : result = (real1 < real2); break;
  618.  
  619.   case MP_GT : result = (real1 > real2); break;
  620.  
  621.   case MP_LE : result = (real1 <= real2); break;
  622.  
  623.   case MP_GE : result = (real1 >= real2); break;
  624.  
  625.   case MP_E  : result = (real1 == real2); break;
  626.  
  627.     default : aok = FALSE;
  628.   }
  629.  
  630.   if (!aok) {
  631.  
  632. DBG_FAIL(fprintf(dbg,"FAIL: Unknown operator id"));
  633.     return FAIL;
  634.   }
  635.  
  636.   if (result) OA_offsets(MPPH_result) = NOT_NIL;
  637.   else        OA_offsets(MPPH_result) = NIL;
  638.  
  639. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  640.   return SUCCESS;
  641. }
  642.  
  643. /*----------------------------------------------------------------------------*
  644.  * Function   : scan_op
  645.  *
  646.  * Parameters : MP_PluralHeap MPPH_arg:
  647.  *        int scan_op_id:
  648.  *        MP_PluralHeap MPPH_result:
  649.  *        
  650.  * Description: Performs a parallel prefix scan operation
  651.  *
  652.  * Result     : int:    FAIL/SUCCESS
  653.  *---------------------------------------------------------------------------*/
  654.  
  655. #ifdef __STDC__
  656.  
  657. int scann_op( MP_PluralHeap MPPH_arg, int scan_op_id, 
  658.        MP_PluralHeap MPPH_result )
  659.  
  660. #else
  661.  
  662. int scan_op( MPPH_arg, scan_op_id, MPPH_result )
  663.  
  664. MP_PluralHeap MPPH_arg;
  665. int scan_op_id;
  666. MP_PluralHeap MPPH_result;
  667.  
  668. #endif
  669.  
  670. {
  671.   int aok = TRUE;
  672.   int result_type;        /* Result is all the same type */
  673.   plural int integer;
  674.   plural float real;
  675.   plural natural tmp = NIL;
  676.   MP_PluralHeap MPPH_tmp = &tmp;
  677.  
  678. DBG_CALL("un_op_id");
  679. DBG_ARGS(fprintf(dbg,"MPPH_arg=????,un_op_id=????,MPPH_result=????"));
  680.   GC_Protect(tmp);
  681.  
  682.   /* Check the plural is non nil - New System, type check sufficient 
  683.    *
  684.    *  if (globalor(OA_offsets(MPPH_arg) == NIL)) {
  685.    *
  686.    *DBG_FAIL(fprintf(dbg,"FAIL: there are nil elements"));
  687.    *      return FAIL;
  688.    *  }
  689.    */
  690.  
  691.   /* Check these are all some kind of number */
  692.  
  693.   if (globalor((OA_info(MPPH_arg) != INTEGER) && 
  694.            (OA_info(MPPH_arg) != MP_FLOAT))) {
  695.  
  696. DBG_FAIL(fprintf(dbg,"FAIL: These aren't all numbers"));
  697.     return FAIL;
  698.   }
  699.  
  700.   if (OA_info(MPPH_arg) == INTEGER) {
  701.  
  702.     integer = *(plural int *plural) OA_data(MPPH_arg);
  703.     real    = (plural float) integer;
  704.  
  705.   }
  706.  
  707.   else {
  708.  
  709.     real    = *(plural float *plural) OA_data(MPPH_arg);
  710.     integer = (plural int) real;
  711.   }
  712.  
  713.   if (OA_info(MPPH_arg) == INTEGER) {
  714.  
  715.     switch (scan_op_id) {
  716.  
  717.     case MP_PLUS : integer = scanAdd32(integer, (plural int) 0); break;
  718.  
  719.     case MP_TIMES : integer = scanMul32(integer, (plural int) 0); break;
  720.  
  721.     case MP_MAX : integer = scanMax32(integer, (plural int) 0); break;
  722.       
  723.     case MP_MIN : integer = scanMin32(integer, (plural int) 0); break;
  724.  
  725.       default : aok = FALSE;
  726.     }
  727.  
  728.     result_type = INTEGER;
  729.   }
  730.   else {
  731.  
  732.     switch (scan_op_id) {
  733.  
  734.     case MP_PLUS : real = scanAddf(real, (plural int) 0); break;
  735.  
  736.     case MP_TIMES : real = scanMulf(real, (plural int) 0); break;
  737.  
  738.     case MP_MAX : real = scanMaxf(real, (plural int) 0); break;
  739.  
  740.     case MP_MIN : real = scanMinf(real, (plural int) 0); break;
  741.  
  742.     default : aok = FALSE;
  743.     }
  744.  
  745.     result_type = MP_FLOAT;
  746.   }
  747.  
  748.   if (!aok) {
  749.  
  750. DBG_FAIL(fprintf(dbg,"FAIL: Unknown unary operator id"));
  751.     return FAIL;
  752.   }
  753.  
  754.   if (mp_alloc((plural int) result_type, (plural int) 1,
  755.            MPPH_result) == FAIL) {
  756.  
  757. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for the result"));
  758.     return FAIL;
  759.   }
  760.  
  761.   if (result_type==INTEGER) *(plural int *plural)OA_data(MPPH_result)=integer;
  762.   else *(plural float *plural) OA_data(MPPH_result) = real;
  763.  
  764.   GC_UnProtect(1);
  765. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  766.   return SUCCESS;
  767.   }
  768.  
  769. /*----------------------------------------------------------------------------*
  770.  * Function   : rnd
  771.  *
  772.  * Parameters : MP_PluralHeap MPPH_result:    the random numbers
  773.  *
  774.  * Description: random number per PE
  775.  *
  776.  * Result     : int:    FAIL, SUCCESS
  777.  *---------------------------------------------------------------------------*/
  778.  
  779. #ifdef __STDC__
  780.  
  781. int rnd( MP_PluralHeap MPPH_result )
  782.  
  783. #else
  784.  
  785. int rnd( MPPH_result )
  786.  
  787. MP_PluralHeap MPPH_result;
  788.  
  789. #endif
  790.  
  791. {
  792.   plural int *plural number;
  793.   
  794. DBG_CALL("rnd");  
  795. DBG_ARGS(fprintf(dbg,"void"));
  796.  
  797.   if (mp_alloc((plural int) INTEGER, (plural int) 1,MPPH_result) == FAIL) {
  798. DBG_FAIL(fprintf(dbg,"FAIL: Uanble to allocate space for rnd numbers"));
  799.     return FAIL;
  800.   }
  801.            
  802.   number = (plural int *plural) OA_data(MPPH_result);
  803.   *number = (plural int) (fp_frandom() * 0x07000000);
  804.  
  805. DBG_EXIT(fprintf(dbg,"SUCCESS: ");DBG_PARG("","%d ",*number));
  806.   return SUCCESS;
  807. }
  808.